00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300		ENTRY	SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500		EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,HOMNEW
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300				;	DIMENSION N(1)
01400	MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13   
01410	J←3  ; WHERE IS THIS USED???
01420	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
01500	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01600		MOVE	1,@4(16)
01700		SUB 	1,@3(16) 	; MM IS IN 1
01800		MOVE	2,@(16)
01900		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
02000		MOVE	3,@1(16)
02100		ADD	3,@3(16)	;J+L
02200		MOVE	4,@2(16)	;K
02300		HRRZI	5,@5(16)		; ADR. OF N
02400		ADDI	2,-1(5)		; N(NN)
02500		ADDI	3,-1(5)
02600		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02700		HRRM	1,.+1		; ADD IN MM 
02800	LP1:	MOVE	6,(2)
02900		MOVEM	6,(2)		;N(NN)=N(NN+MM)
03000		CAIGE	2,(3)
03100		AOJA	2,LP1
03200		JRA	16,6(16)
03300	LP3:	HRRM	1,.+1
03400	LP2:	MOVE	6,(2)		;NEG. INCR.
03500		MOVEM	6,(2)
03600		CAILE	2,(3)
03700		SOJA	2,LP2
03800		JRA 	16,6(16)	;	END
03900	
04000	PLACE:	0	;	FUNCTION PLACE(X)
04100	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04200	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04300		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04400		FADR	2,XRN+=3999 	;END
04500		MOVMS	2
04600		MOVE 	0,.COMM.+=12	;R11
04700		FSBR	0,2
04800		JRA	16,1(16)
04900	
05000	FINDIT:	0    ;	FUNCTION FINDIT(N)
05100		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05200		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05300	;;	HRRZI	2,PTR  ;	FINDIT=0
05400	;;	ADDI	1,(2)  ;	L=PWDS(N)
05500	;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05600	;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05700	;;	HRRZI	3,XRN     ;377	FINDIT=-1
05800	;;	ADDI	3,(2)   ;	END
05900	;;	MOVE 5,(3)   ; RN(L+1)
06000		MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
06100	;X	FIXX(2)
06200		MOVE 5,XRN(2)
06300		CAME	5,[1.0]
06400		JRST	FNEG
06500		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
06600	;;	MOVE	5,1(3)  ;RN(L+2)
06700		MOVE 5,XRN+1(2)
06800		CAME	5,.COMM.
06900	FNEG:	SETO
07000		JRA	16,1(16)
07100	
07200	DPYNEW:	0    ;	SUBROUTINE DPYNEW
07300		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07400		JUMP	[1]    ;	CALL ACCPOG(1)
07500		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
07600		JUMPG	2,DB    ;	CALL DPYOUT(1)
07700		JSA	16,DPYOUT    ;	END
07800		JUMP	[1]
07900	DB:	JRA	16,(16)
08000	
08100	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
08200		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
08300		MOVE	5,@1(16)  ; I
08400		ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
08500		ADD	2,@2(16)  ;	DIMENSION R(1)
08600		MOVE	3,-1(2)  ;	Y=R(JY+I)
08700		MOVM	4,3   ;	Z=ABS(Y)
08800		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
08900		JRST	MV1
09000		CAML	5,[6]
09100		JRST	MV1	;  IF(I.GT.5)GO TO 1
09200	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
09300		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
09400		JUMP	3  
09500		JUMP	[=100.0]  ; 0 HAS Y
09600		MOVE	5,@4(16)  ;	X=Y+W
09700		FADR	5,0
09800		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
09900		MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
10000		FSBR	4,7
10100		FADR	4,6
10200		SKIPGE 	5  ;	IF(X)Z=-Z
10300		MOVNS	4    ; Z
10400		JRST 	MV2 ;	GO TO 2
10500	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
10600		MOVE	4,3   ; Z NOW IN 4
10700	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
10800		ADD	3,@3(16)
10900		ADD	3,@1(16)
11000		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
11100		JRA	16,5(16)	; END
11200	
11300	MVBX:	0   ;	SUBROUTINE MVBX(I)
11400	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11500		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11600		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
11700	;;	HRRZI	4,XRN
11800	;;	ADDI	2,(4)
11900	;;	MOVE	3,-1(2)  ; R(JY+I)
12000		MOVE 3,XRN-1(2)
12100		FSBR	3,.COMM.+5
12200		FMPR	3,.COMM.+=25  ; *RDIS
12300		FADR	3,.COMM.+=9   ; +R8
12400		MOVE	2,@(16)
12500		ADD	2,.COMM.+=24   ; + L
12600	;;	ADDI	2,(4)
12700	;;	MOVEM	3,-1(2)    ;R(L+I)
12800		MOVEM 3,XRN-1(2)
12900		JRA	16,1(16)
13000	
13100	JUGGLE:	0    ;	SUBROUTINE JUGGLE
13200	;	IMPLICIT INTEGER(A-Z)
13300	;	REAL PWDS,RN
13400	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
13500	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13600		SOS	PTR+=250	;ITEM=ITEM-1
13700		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
13800	;C  I-IX IS WD CNT OF NEW ITEM
13900		ADD	15,DPY+=4250
14000		MOVE	14,-1(15)
14100		FIXX(14)
14200		ADDI	14,3  		; JX
14300		MOVE	13,PTR+=253	;JY=IX
14400		MOVE	11,PTR+=252	; I
14500		SUB	11,13
14600		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
14700		JUMPL	11,J2751   	;IF(Z)2751,172,751
14800		JUMPE	11,J172
14900		MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15000		SUBI	5,1
15100		MOVE	10,DPY+=4250
15200		ADD	10,14
15300		JSA	16,LOOP
15400		JUMP	5
15500		JUMP	10
15600		JUMP	[-1]
15700		JUMP	11
15800		JUMP	[0]
15900		JUMP	XRN
16000		ADD	13,11		;JY=IX+Z
16100		JRST	J172		;GO TO 172
16200	J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
16300		ADD	14,11
16400		MOVE	5,11
16500		ADD	5,PTR+=253
16600		SOJ	5,
16700		MOVN	10,11
16800		JSA	16,LOOP
16900		JUMP	14
17000		JUMP	5
17100		JUMP	[1]
17200		JUMP	[0]
17300		JUMP	10
17400		JUMP	XRN
17500	;;J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
17600	;;	ADDI	12,(13) 		; JY
17700	J172:	MOVE 12,XRN-1(13)
17800	;;	MOVE	12,-1(12) 	;RN(JY)
17900		FIXX(12)
18000		ADDI	12,2		; J IS IN 12
18100		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
18200		JUMP	[0]
18300		JUMP	12
18400		JUMP	[1]
18500		JUMP	DPY+=4250	; MEDIT
18600		JUMP 	13		; JY
18700		JUMP	XRN
18800		MOVE	12,PTR+=253	; I=IX+Z
18900		ADD	12,11		; Z IS IN 11
19000		MOVEM	12,PTR+=252
19100		MOVE	12,PTR+=250  	; 1751	X=ITEM+1
19200		AOJ	12,	    	; X IS IN 12
19300		HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
19400		ADD	13,DL	
19500		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
19600		SUB  	14,-1(13)	;JX IN 14
19700		HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
19800		ADDI	10,(12)
19900		MOVE	7,(10)		;WDS(X+1)
20000		SUB	7,-1(10)		;J IN 7
20100		MOVEM	7,MVBX		; STORE J
20200		SUB	7,14    	; Y=J-JX
20300		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
20400		ADD	14,7
20500		AOJ	14,		; JX IN 14
20600		JUMPL	7,J2851   	;  IF(Y)2851,182,282
20700		JUMPE	7,J182
20800		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
20900		ADDI	15,2	  	; ARG 1
21000		MOVE	6,-1(13) 	;  ARG 2
21100		JSA	16,LOOP
21200		JUMP	15
21300		JUMP	6 
21400		JUMP	[-1]
21500		JUMP	7	  	; Y
21600		JUMP	[0]
21700		JUMP	DPY
21800		JRST	J182   		;  GO TO 182
21900	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
22000		ADD	14,7		;+Y
22100		ADDI	14,1		; ARG 1
22200		MOVE	5,-1(10) 	;WDS(X)
22300		ADD	5,7
22400		ADDI	5,1		; ARG 2
22500		MOVNM	7,MVBEAM	; -Y IS STORED
22600		JSA	16,LOOP
22700		JUMP	14
22800		JUMP	5
22900		JUMP	[1]
23000		JUMP	[0]
23100		JUMP	MVBEAM
23200		JUMP	DPY
23300		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
23400		ADDI	14,1		; JX IN 14
23500	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
23600		ADDI	5,1   	;WDS(X22)+1
23700		JSA	16,LOOP
23800		JUMP	[1]
23900		JUMP	MVBX
24000		JUMP	[1]
24100		JUMP	5  
24200		JUMP	14 
24300		JUMP	DPY
24400		MOVE	2,DL    	; DO 183 K=X22+1,X
24500	;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
24600	;;	ADD	5,2
24700		HRRZI	3,PTR
24800		ADDI	3,(2)
24900	;;	TLC	11,232000	; FLOAT Z
25000	;;	FADR	11,11
25100	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
25200		ADDM 11,(3)		; PWDS(K)=PWDS(K)+Z
25300		AOJ	3,	;UPDATE PWDS AND WDS
25400	J184:	JUMPE	7,J185
25500		ADDM 7,(13)
25600		AOJ 13,
25700	J185:	CAIGE	2,(12)
25800		AOJA	2,J183
25900	;;	HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
26000	;;	ADDI	2,(12)		;WDS(X+1) ADR.
26100	;;	MOVE	2,-1(2)
26200		MOVE 2,DPY+=3999(12)
26300	;;	HRRZI	3,DPY
26400	;;	MOVEM	2,1(3)
26500		MOVEM 2,DPY+1
26600		SETZM	DL		;X22=0
26700		JRA	16,(16)
26800	
26900	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
27000		MOVEI	2,2	;DIMENSION RPOS(2,200)
27100	S3:	MOVE	6,2	;(K=L HERE)
27200		SETO	11,	;L=2
27300		HRRZI	3,@(16)	;3	J=-1
27400		MOVE	4,2	;RX=RPOS(1,L-1)
27500		SUBI	4,1	;L-1
27600		IMULI	4,2
27700		ADDI	4,(3)
27800		MOVE	5,-2(4)	;RX
27900	S2:	MOVE 	7,6	;	DO 2 K=L,M
28000	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
28100		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
28200		ADDI	7,(3)
28300		CAMG	5,-2(7)
28400		JRST	S1	; CONTINUE
28500		MOVE	5,-2(7)	;  RX=RPOS(1,K)
28600	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
28700		MOVE 	11,6	;J=K
28800	S1:	CAMGE	6,@1(16)	;2	CONTINUE
28900		AOJA	6,S2
29000		JUMPL	11,S4	;IF(J)GO TO 4
29100		MOVE	12,2	;K=L-1
29200		SOS	12
29300		IMULI	12,2	;(K*2)
29400		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
29500		MOVE	10,-2(12)
29600	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
29700		IMULI	11,2
29800		ADD	11,3
29900		EXCH	10,-2(11)
30000		MOVEM	10,-2(12)
30100		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
30200		EXCH	10,-1(11)
30300		MOVEM	10,-1(12)
30400	S4:	CAMGE	2,@1(16)	;4	L=L+1
30500		AOJA	2,S3		;IF(L.LE.M)GO TO 3
30600		JRA	16,2(16)	;END
30700	
30800	XNOTE:	0		;FUNCTION XNOTE(J)
30900		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
31000		IMULI	3,12		;DIMENSION R(10,80)
31100	;;	ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
31200	;;	MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
31300		MOVE 2,XRN+=2993(3)
31400		JSA	16,AMOD
31500		JUMP	2
31600		JUMP	[=100.0]
31700		JRA	16,1(16)	;END
31800	
31900	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
32000				;C  FOR AUTOMATIC BEAMS.
32100		MOVEI 2,2 	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
32200		ADDB 2,@(16)		;J=J+2
32300		MOVE	3,@3(16)
32400		MOVE	4,@1(16)
32500		SUB	4,3		;L-N
32600		MOVE	5,@2(16)
32700		SUB	5,3		;K-N
32800	;;	HRRZI	6,SCM
32900	;;	ADDI	6,(2)
33000		TLC	4,232000
33100		FADR	4,4		;FLOATS IT
33200	;;	MOVEM	4,-2(6)		;V(J-1)=L-N
33300		MOVEM 4,SCM-2(2)
33400		TLC	5,232000
33500		FADR	5,5		;FLOATS IT
33600	;;	MOVEM	5,-1(6)		;V(J)=K-N
33700		MOVEM 5,SCM-1(2)
33800		JRA	16,4(16)
33900	
34000	UPDATE:	0	;	SUBROUTINE UPDATE(I)
34100	;;	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
34200	;;	ADD	3,PTR+=252	;RN(IS)=I
34300		MOVE 3,PTR+=252
34400		MOVE	2,@(16)
34500		TLC	2,232000	;FLOAT I
34600		FADR	2,2
34700	;;	MOVEM	2,-1(3)
34800		MOVEM 2,XRN-1(3)
34900	;;	MOVE	2,PTR+=252
35000	;;	ADD	2,@(16)
35100	;;	ADDI	2,3
35200	;;	MOVEM	2,PTR+=252	;IS=IS+I+3
35300		MOVE 2,@(16)
35400		ADDI 2,3
35500		ADDM 2,PTR+=252
35600		JRA	16,1(16)
35700	
35900	IK:	0
36000	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
36100	NEWR:	0	;	SUBROUTINE NEWR
36200		MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
36300		CAIE	A,1		;COMMON/XRN/RN(4000)
36400		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
36500		MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
36600		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
36700		MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
36800	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
36900	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
37000		MOVEM	IS,PTR+=252
37100		MOVE 14,[9999.0]
37200		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
37300		ADDI	JT,1		;IK=IS
37400		MOVEM	JT,PTR+=250	;JIT=ITEM
37500		MOVEI	K,=10		;1	IS=IK
37600		MOVE	IZ,SCX+=41	;ITEM=JIT+1 ******************** WAS +=33
37700		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
37800	;;N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
37900	;;;;N2:	MOVE	R,XRN+=2997(K)	;DO 2 K=1,IZ
38000	;;	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
38100	;;	MOVE	R,(R)
38200	;;;;	CAMN	R,[=9999.0]
38300	N2:	CAMN 14,XRN+=2997(K)
38400		JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
38500		SETO	IEND,		;C  JUMP FOR BEAM CONT.
38600	;;	HRRZI	L,XRN		;IEND=-1
38700	;;	ADD	L,PTR+=252	;RN(IS+3)=0
38800	;;	SETZM	2(L)
38900	;;	SETZM	1(L)		;RN(IS+2)=0
39000		MOVE L,PTR+=252
39100		SETZM XRN+2(L)
39200		SETZM XRN+1(L)
39300		MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
39400	;;N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
39500	N3:	HRRZI	R,XRN+=3000(K)	;DO 3 L=9,1,-1
39600	;;	ADDI	R,(K)		;A=R(L,K)
39700		ADDI	R,(L)
39800		MOVE	A,-13(R)	;(OCTAL)=-11
39900		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
40000		JUMPN	A,NX3		;IF(IEND)GO TO 3
40100		JRST	NN3
40200	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
40300	;;NX4:	HRRZI	R,XRN
40400	;;	ADD	R,PTR+=252	;RN(IS+L)=A
40500	;;	ADDI	R,(L)
40600	;;	MOVEM	A,-1(R)
40700	NX4:	MOVE R,PTR+=252
40800		ADDI R,(L)
40900		MOVEM A,XRN-1(R)
41000	NN3:	CAILE	L,1		;3	CONTINUE
41100		SOJA	L,N3
41200		CAIGE	IEND,3
41300		MOVEI	IEND,3
41400		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
41500		SUBI	15,2
41600		JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
41700		JUMP	15
41800	NN2:	CAML	K,IZ		;2	CONTINUE
41900		JRA	16,(16)		;END
42000		ADDI	K,=10
42100		JRST	N2
42200	
42300	CNT:	0
42400	MSSLUP:	0
42500		SETZ	1,		;161	CNT=1
42600		SETZ	2,
42700	L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,9
42800	;;	ADDI	3,(2)
42900	;;	MOVE	3,(3)		;RA=RJQ(K)
43000		SKIPE	3		;IF(RA.NE.0)CNT=K
43100		MOVE	1,2
43200	;;	MOVEI	4,RRJJ+1	;5543	RJJ(K)=RA
43300	;;	ADDI	4,(2)
43400	;;	MOVEM	3,(4)
43500		MOVEM 3,RRJJ+1(2)
43600		CAIG	2,7		; LOOP BACK?
43700		AOJA	2,L5543
43800		AOJ	1,
43900		MOVEM	1,CNT		;REMEMBERS CNT
44000		JRA	16,(16)
44100	
44200	LUP2:	0
44300	;;	MOVEI	1,XRN		;261	RN(I)=CNT
44400	;;	ADD	1,PTR+=252
44500		MOVE	2,CNT
44600		TLC	2,232000
44700		FADR	2,2		;FLOATS IT
44800	;;	MOVEM	2,-1(1)
44900		MOVE 1,PTR+=252
45000		MOVEM 2,XRN-1(1)
45100		MOVE	2,.COMM.+1	;RN(I+1)=JA
45200		TLC	2,232000
45300		FADR	2,2
45400	;;	MOVEM	2,(1)
45500	;;	MOVE	2,PTR+=252	;I=I+2
45600	;;	ADDI	2,2
45700	;;	MOVEM	2,PTR+=252
45800		MOVEM 2,XRN(1)
45900		ADDI 1,2
46000		MOVEM 1,PTR+=252
46100		MOVE	3,.COMM.	;RN(I)=R2
46200	;;	MOVEM	3,1(1)
46300		MOVEM 3,XRN-1(1)
46400	;; NOT USED NOW!	IF(RD.NE.0)RN(I)=RD
46500	;;C TO SAVE NOTE NUMBS IN P2.
46600		SETZ	5,		;DO 4554 K=1,CNT
46700	L4554:	MOVE 2,.COMM.+4(5)
46800	;;L4554:	MOVEI	2,.COMM.+4	;(RJQ)
46900	;;	ADDI	2,(5)
47000	;;	MOVE	2,(2)
47100	;;	MOVEI	3,XRN(5)
47200	;;	ADDI	3,(5)
47300	;;	ADD	3,PTR+=252
47400	;;	MOVEM	2,(3)		;4554	RN(I+K)=RJQ(K)
47500		MOVE 3,1
47600		ADDI 3,(5)
47700		MOVEM 2,XRN(3)
47800		AOJ	5,
47900		CAME	5,CNT
48000		JRST	L4554
48100		AOJ	5,
48200	;;	ADD	5,PTR+=252
48300		ADDM 5,PTR+=252
48400	;;	MOVEM	5,PTR+=252	;3554	I=CNT+1+I
48500		JRA	16,(16)
48600	
48800	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
48900	;;	SUBROUTINE HOMER
49000	;;	IMPLICIT INTEGER(A-Q,S-Z)
49100	;;	REAL PWDS,DISX,A,B,PLACE,STFF
49200	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
49300	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
49400	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
49500	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
49600	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
49700	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
49800	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
49900	HOMER:	0		; IF(JA.EQ.6)GO TO 9
50000		MOVE	MM,.COMM.+1
50100		CAIN	MM,6
50200		JRST	H9
50300		SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
50500		JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
50600		SKIPN	.COMM.+=24	;IF(J3.EQ.0)GO TO 197
50700		JRST	H197	; NEXT TO HOME IN ON NOTE ON DIFFERENT STAFF.
50800	
50810		MOVE PTR+=250		;JJ2=ITEM (FOR RETURN WITH NO CHANGE)
50820		MOVEM POSI+=8
50900				; IF(JA.EQ.6)GO TO 9
51100		MOVE	K,.COMM.	;JJ2=R2
51200		FIXX(K)
51400		MOVE	K,PTR-1(K)	;K=PWDS(J2) ← BEAM PTR.
51500		MOVE XRN(K)
51600		CAME [6.0]	; IS IT REALLY A BEAM?
51700		JRA 16,(16)	;NO - GO BACK
51800	;******* 19, ITEM# OF BEAM, +1 FOR STAFF ABOVE, -1 FOR BELOW.
51850		MOVEM K,.COMM.+3	;SAVES IT IN J2
51900		MOVE R,XRN+5(K) ; POS OF RT. SIDE OF BEAM SAVED IN R
52000		SETZ MM,	; 0=BEAM STEM ↓
52100		MOVE XRN+6(K)	;RN(K+7)  STEM DIR.
52200		CAMGE [20.0]	;IS IT UP?
52300		SETO MM,	; YES    -1=BEAM STEM ↑
52305		MOVEM MM,ALF+=21	;SAVE IT 'TIL AFTER AMOD
52310		MOVE A,XRN+1(K)		;SAVE BEAM'S STAFF #
52320		MOVEM A,ALF+8
52420		MOVE 5,A
52500		MOVE .COMM.+4		; 2ND PARAM
52510		CAMN [0.1]	; USE .1 FOR SAME STAFF
52520		SETZ 
52525		MOVEM .COMM.+4
52530		FADR A,
52810		MOVEM A,ALF+5	; SAVE NOTES' STAFF #
52900		SETZ L,		; NEXT IS SEARCH LOOP
52910		MOVE IZ,[1.0]
52920		MOVE NN,.COMM.+5 ;IF(R4.EQ.0)R4=3.0   SETS HOMING RANGE
52930		SKIPN NN
52940		MOVE NN,[3.0]
53000	H401:	MOVE JK,PTR(L)	; JK=KWDS(L)
53100		CAMN 5,XRN+1(JK)	;IF RN(JK).NE.STF, SKIP
53110		JRST .+3
53120		CAME A,XRN+1(JK)	 ; LOOKS ON BOTH STAVES FOR END NOTE OF BEAM
53200		JRST H402
53300		CAME IZ,XRN(JK)	; IS IT A NOTE?
53400		JRST H402	; NO
53500		MOVE XRN+2(JK)	;POS OF NOTE
53600		FSBR R	; NOTE POS - RT. SIDE OF BEAM
53700		MOVM		; ABS. VALUE
53800		CAMG NN	 	;  3.0 RANGE FOR HOMING  - P4
53900		JRST H403	; NO CLOSE ENOUGH
54000	H402:	AOJ L,		; ADD ONE FOR LOOP
54100		CAMGE L,PTR+=250	; UP TO ITEM YET?
54200		JRST H401
54210	
54300		JRA 16,(16)	;COULDN'T HOME IN.
54400	H403:	MOVEM JK,ALF	; FOR JK=KWDS(L) -- NT PTR. SAVE IT FOR HOMNEW
54500		MOVE NX,[1.0]
54600		MOVE XRN+3(JK)	;RN(JK+4) NOTE HGT.
54700		CAML [80.0]
54800		MOVE NX,[0.6]	; MINI-NOTE
54900		MOVEM NX,STF+=8		; PUT IT IN RSTJ2
55000	
55100		SETZM ALF+=17	;NOTE STEM -- 0=↓
55200		MOVE XRN+4(JK)  ;RN(JK+5)
55300		CAMGE [20.0]
55400		SETOM ALF+=17	;  STEM  -- -1=↑
56900		MOVE	0,XRN+6(K)	;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
57000		MOVEM	0,ALF+=13		;RN(K+7)
57200		JSA	16,AMOD
57300		JUMP	ALF+=13
57400		JUMP	[=10.0]
57500		FSBR	0,[=1.0]
57600		FMPR	0,[=1.5714]
57700		FMPR 0,NX	; *RMINI (.6)
57800		MOVEM	0,ALF+=15		;RG SAVED IN ALF+=15
57900	;   VERTICAL SPACE FOR THE NUMB. OF BEAMS
58510		MOVE JK,ALF+8		;GET BEAM'S STAFF #
58600		FIXX(JK)		; JK IS IN JK
58650		MOVEM JK,ALF+=8		;SAVE IT
58700	;  THE STAFF NUMS.  JK=BEAM   JT=NOTE
58800		MOVE	IS,STF+3(JK)	;R3=RSTFAC(JK)  R3 IS IN 'IS'
58900		FMPR IS,NX	; *RMINI (.6)
59000	;;	MOVE	IZ,STF+3(JT)	;R9=RSTFAC(JT)/R3
59100		FMPR	IS,[=2.43959732]	;R8=R3*14.54/5.96
59200		MOVEM IS,ALF+=14
59300	;  R8=WIDTH OF NOTE
59310	
59320	;************************************************
59332		MOVE MM,ALF+5
59334		FIXX(MM)		; THESE FOR FORTR. ROUTINE
59337		MOVEM MM,ALF+5
59340		JSA 16,HOMNEW	;CALL FORTRAN ROUTINE FOR NOW.
59360		JRA 16,(16)
59370	
59380	
59400	
59500	;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
64300	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
64400	H197:	SETOM POSI+=8		;197	JJ2=-1
64600		MOVE	R,.COMM.		;R3=R2
64700		MOVEM	R,JIT
64800		SETZ	K,		;DO 191 K=1,ITEM
65600	H191:	MOVEM	K,LOOP		;SAVE K       	L=PWDS(K)
65700		MOVE	L,PTR(K)	; L IS PWDS(K+1)
65800			;IF(RN(L+1).NE.6)GO TO 191
65900		MOVEI	R,XRN(L)
66000		MOVE	A,(R)
66100		CAME	A,[=6.0]
66200		JRST	HX191
66300		MOVE	JK,JIT		;IF(RN(L+2).EQ.R3)GO TO 77
66400		CAMN	JK,1(R)
66500		JRST	H77
66600		CAMGE	JK,[=5.0]	;IF(R3.LT.5.)GO TO 191
66700		JRST 	HX191		; TYPE 19 99 FOR ALL STAVES
66800	H77:	MOVE	JK,-1(R)		;77
66900		CAMN	JK,[=8.0]	;IF(RN(L).EQ.8)GO TO 191
67000		JRST	HX191
67100		MOVE	JK,6(R)		;IF(RN(L+7).LT.10.)GO TO 191
67200		CAMGE	JK,[=10.0]	;C  FINDS BEAMS.
67300		JRST	HX191
67400		FDVR	JK,[=10.0]	;X=RG/10.
67500		FIXX(JK)			;C  STEM DIRECT.
67600		MOVEM	JK,IK		;X SAVED IN IK
67700		MOVE	JK,1(R)		;R2=RN(L+2)
67800		MOVEM	JK,.COMM.	; USED IN 'FINDIT'
67900		MOVE	A,2(R)		;A=RN(L+3)-.01
68000		FSBR	A,[=0.01]
68100		MOVEM	A,NEWR		;SAVE A IN NEWR
68200		MOVE	JK,5(R)		;B=RN(L+6)+.01
68300		FADR	JK,[=0.01]	;C  POS 1 AND 2
68400		MOVEM	JK,BAUTO		;B SAVED IN BAUTO
68500		FSBR	JK,A		;DISX=B-A
68600		MOVEM	JK,UPDATE	;DISX SAVED IN UPDATE
68700	;  DISTANCE IN REAL STEPS
68800		MOVEM	R,MVBX		;SAVE LOC OF RN(L+1)
68900		MOVE	0,3(R)
69000		MOVEM	0,JUGGLE
69100		JSA	16,AMOD		;RF=AMOD(RN(L+4),100.0)
69200		JUMP	JUGGLE 
69300		JUMP	[=100.0]
69400		MOVEM	0,JUGGLE; THIS IS RF!!!!
69500	;  NOTE 2
69600		MOVE	JK,MVBX 
69700		MOVE	JK,4(JK)
69800		MOVEM	JK,MSSLUP
69900		JSA	16,AMOD		;RB=AMOD(RN(L+5),100.0)
70000		JUMP	MSSLUP 
70100		JUMP	[=100.0]	;0 WILL HAVE RB!!!
70200		FSBR	0,JUGGLE 
70300		MOVEM	0,SORT2 		;RD SAVED IN ALF+=9  --  RD=RB-RF
70400		MOVEI NX,1
72600	H192:	JSA	16,FINDIT	;IF(FINDIT(N))GO TO 192
72700		JUMP	NX
72800		JUMPL	0,HX192
72900		MOVEI	R,XRN		;IF(RN(L).EQ.8)GO TO 192
73000		ADD	R,PTR+=251	;LOC OF RN(L+1)
73100		MOVE	JK,-1(R)
73200		CAMN	JK,[=8.0]
73300		JRST	HX192
73400		MOVE	JK,7(R)		;IF(RN(L+8).EQ.1000.)GO TO 192
73500		CAMN	JK,[=1000.0]
73600		JRST	HX192	; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
73700	;  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
73800		MOVE	A,2(R)		;RC=RN(L+3)
73900		CAMGE	A,NEWR		;IF(RC.LT.A)GO TO 192
74000		JRST	HX192
74100		CAMLE	A,BAUTO		;IF(RC.GT.B)GO TO 192
74200		JRST	HX192	;  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
74300		MOVE	JK,4(R)		;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
74400		FDVR	JK,[=10.0]
74500		FIXX(JK)
74600		CAME	JK,IK
74700		JRST	HX192
74800		FSBR	A,NEWR		;RC=RC-A
74900		MOVEM	A,MVBEAM;SAVES RC
75000		MOVEM	R,MVBX 		;SAVE LOC OF RN(L+1)
75100		MOVE 	0,3(R)
75200		MOVEM	0,MSSLUP
75300		JSA	16,AMOD		;193	RE=AMOD(RN(L+4),100.0)
75400		JUMP	MSSLUP
75500		JUMP	[=100.0]
75600		MOVEM	0,ALF+3		;RE SAVE HERE
75700		MOVE	JK,SORT2 		;RC=RD*RC/DISX+RF
75800		FMPR	JK,MVBEAM	;*RC
75900		FDVR	JK,UPDATE 	;/DISX
76000		FADR	JK,JUGGLE 	;+RF
76100		MOVEM	JK,MVBEAM	;RC=
76200		MOVE	JK,MVBX
76300		MOVE	JK,6(JK)		;RG=RN(L+7)
76400		MOVEM	JK,ALF+4		;SAVE RG
76500		JSA	16,AMOD		;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
76600		JUMP	ALF+4
76700		JUMP	[=10.0]
76800		MOVEM	0,LUP2
76900		JSA	16,AMOD
77000		JUMP	ALF+4
77100		JUMP	[=1.0]
77200		FSBR	0,LUP2
77300		FADR	0,ALF+4
77400		MOVE	L,MVBX
77500		MOVEM	0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
77600	;  FRACTIONAL NOTE #
77700		MOVE	R,MVBEAM	;195	RA=RC-RE
77800		FSBR	R,ALF+3
77900		MOVE	JK,IK		;IF(X.EQ.2)RA=-RA
78000		CAIN	JK,2
78100		MOVNS	R
78200		SKIPN	R		;IF(RA.EQ.0)RA=999.
78300		MOVE	R,[=999.0]
78400		MOVEM	R,7(L)		;196	RN(L+8)=RA
78500	;  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
78600		SKIPGE	POSI+=8
78700		MOVEM	NX,POSI+=8	;  SAVES # OF LOWEST ITEM FOUND
78800	HX192:	CAMGE	NX,PTR+=250	;192	CONTINUE
78900		AOJA	NX,H192
79000	HX191:	MOVE	K,LOOP		;191	CONTINUE
79100		CAMGE K,PTR+=250
79200		AOJA K,H191
79500		JRA	16,(16)		;RETURN
80400	H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
80500		JRA	16,(16)		;   IF P11=-1 NO HOMING
80600		MOVE	R,.COMM.+=8	;	X=R7/10.
80700		FDVR	R,[=10.0]
80800		FIXX(R)
80900		SKIPGE	R		;IF(X)X=-X
81000		MOVNS	R
81100		MOVEM	R,IK		;X SAVED IN IK
81200	;  X IS STEM DIRECTION
81300		MOVE	L,.COMM.+=10	;RA=R9
81400	;  R9= POS3
81500		MOVNI	RC,1	;RC=-1 
81600		SKIPE	L		;IF(R9.NE.0)RC=-2
81700		MOVNI	RC,2
81800		MOVE	JK,.COMM.+=31	;IF(J10/10.EQ.3)RC=-3
81900		IDIVI	JK,=10
82000		CAIN	JK,3
82100		MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
82200	;;;	JRST	HZ10
82300	;;;H10:	SETZ	RC,		;FOR P13=1
82400	;   HOMING RANGE FOR BEAMS
82500	;;;HZ10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
82600	H10:	MOVE	IS,.COMM.+=12	;10	IF(R11.EQ.0)R11=2.9
82700		JUMPN	IS,HX10
82800		MOVE	IS,[=2.9]
82900		MOVEM	IS,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
83000	HX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
83100		CAIN	IZ,5
83200		MOVNI	RC,1
83300		MOVEI	K,1
83400	H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
83500		JUMP	K
83600		JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
83700	;  SKIPS NOTES ON WRONG LINE 
83800		MOVEI	R,XRN		;RD=RN(L+3)
83900		ADD	R,PTR+=251	;LOC OF RN(L+1)
84000		MOVE	A,2(R)		;RD IN A
84100		MOVEM	A,XRN+=3999	;1	IF(JA.NE.6)GO TO 177
84200		MOVE	JK,.COMM.+1
84300		CAIE	JK,6
84400		JRST	H177
84500		MOVE	JK,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
84600		FDVR	JK,[=10.0]
84700		FIXX(J)
84800		CAME	JK,IK
84900		JRST	HX361
85000	H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
85100		JUMP	.COMM.+4
85200		JUMPL	H461
85300		MOVEM	A,.COMM.+4	;R3=RD
85400	;  LOOKS FOR NOTE, STAFF #, STEM DIR.
85500		MOVE	JK,.COMM.+1	;IF(JA.EQ.6)GO TO 861
85600		CAIN	JK,6
85700		JRST	 H861
85800		CAIN	JK,5		;IF(JA.EQ.5)GO TO 261
85900		JRST	H261
86000		JRA	16,(16)		;RETURN
86100	H461:	MOVE	JK,.COMM.+1	;461	IF(JA.EQ.6)GO TO 277
86200		CAIN	JK,6
86300		JRST	H277
86400		CAIE	JK,5		;IF(JA.NE.5)GO TO 361
86500		JRST	HX361
86600	H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
86700		JUMP	.COMM.+7
86800		JUMPL	H561
86900		MOVEM	A,.COMM.+7	;R6=RD
87000	H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
87100		JUMPGE	0,H261
87200	H561:	JSA	16,PLACE	;561	IF(PLACE(RA))GO TO 661
87300		JUMP	L
87400		JUMPL	H661
87500		MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
87600		JUMPL	H761	;  J7=NEG MEANS TREMOLO
87700		MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
87800		JUMPN	H761
87900		MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
88000		JUMPE	HX361
88100	H761:	MOVEM	A,.COMM.+=10	;761	R9=RD
88200	;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
88300		JRST	H261		;GO TO 261
88400	H661:	CAIN	JK,5		;661	IF(JA.EQ.5)GO TO 361
88500		JRST	HX361
88600		MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
88700		CAIGE	0,=30
88800		JRST	HX361
88900		JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
89000		JUMP	.COMM.+=9
89100		JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
89200		MOVEM	A,.COMM.+=9	;R8=RD
89300	H261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
89400		JRA	16,(16)    
89500		AOJ	RC		;RC=RC+1
89600	HX361:	CAMGE	K,PTR+=250	;361 	CONTINUE
89700		AOJA	K,H361
89800		JRA	16,(16)		;	END
89900	
90000	;	CALL FSCAN
90100	;	GOTO RT
90200	;	GOTO LF
90300	;	GOTO UP
90400	;	GOTO DW
90500	;	GOTO 1/2
90600	;	GOTO *2
90700	;	GOTO X
90800	;	GOTO C
90900	;	ALL OTHERS(EXIT)
91000	
91100	FSCAN:	0
91200		INCHRW
91300		CAIN ";"
91400		JRA 16,(16)
91500		CAIN ":"
91600		JRA 16,1(16)
91700		CAIN "("
91800		JRA 16,2(16)
91900		CAIN ")"
92000		JRA 16,3(16)
92100		CAIN "/"
92200		JRA 16,4(16)
92300		CAIN "*"
92400		JRA 16,5(16)
92500		CAIN "X"
92600		JRA 16,6(16)
92700		CAIN "C"
92800		JRA 16,7(16)
92900		JRA 16,8(16)
93000		END